home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / Net / hostent.pm next >
Encoding:
Perl POD Document  |  1999-12-28  |  4.0 KB  |  149 lines
  1. package Net::hostent;
  2. use strict;
  3.  
  4. BEGIN { 
  5.     use Exporter   ();
  6.     use vars       qw(@EXPORT @EXPORT_OK %EXPORT_TAGS);
  7.     @EXPORT      = qw(gethostbyname gethostbyaddr gethost);
  8.     @EXPORT_OK   = qw(
  9.             $h_name            @h_aliases
  10.             $h_addrtype     $h_length
  11.             @h_addr_list     $h_addr
  12.            );
  13.     %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
  14. }
  15. use vars      @EXPORT_OK;
  16.  
  17. sub import { goto &Exporter::import }
  18.  
  19. use Class::Struct qw(struct);
  20. struct 'Net::hostent' => [
  21.    name        => '$',
  22.    aliases    => '@',
  23.    addrtype    => '$',
  24.    'length'    => '$',
  25.    addr_list    => '@',
  26. ];
  27.  
  28. sub addr { shift->addr_list->[0] }
  29.  
  30. sub populate (@) {
  31.     return unless @_;
  32.     my $hob = new();
  33.     $h_name      =    $hob->[0]              = $_[0];
  34.     @h_aliases     = @{ $hob->[1] } = split ' ', $_[1];
  35.     $h_addrtype  =    $hob->[2]          = $_[2];
  36.     $h_length     =    $hob->[3]          = $_[3];
  37.     $h_addr      =                             $_[4];
  38.     @h_addr_list = @{ $hob->[4] } =          @_[ (4 .. $#_) ];
  39.     return $hob;
  40. } 
  41.  
  42. sub gethostbyname ($)  { populate(CORE::gethostbyname(shift)) } 
  43.  
  44. sub gethostbyaddr ($;$) { 
  45.     my ($addr, $addrtype);
  46.     $addr = shift;
  47.     require Socket unless @_;
  48.     $addrtype = @_ ? shift : Socket::AF_INET();
  49.     populate(CORE::gethostbyaddr($addr, $addrtype)) 
  50. } 
  51.  
  52. sub gethost($) {
  53.     if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
  54.     require Socket;
  55.     &gethostbyaddr(Socket::inet_aton(shift));
  56.     } else {
  57.     &gethostbyname;
  58.     } 
  59. } 
  60.  
  61. 1;
  62. __END__
  63.  
  64. =head1 NAME
  65.  
  66. Net::hostent - by-name interface to Perl's built-in gethost*() functions
  67.  
  68. =head1 SYNOPSIS
  69.  
  70.  use Net::hostnet;
  71.  
  72. =head1 DESCRIPTION
  73.  
  74. This module's default exports override the core gethostbyname() and
  75. gethostbyaddr() functions, replacing them with versions that return
  76. "Net::hostent" objects.  This object has methods that return the similarly
  77. named structure field name from the C's hostent structure from F<netdb.h>;
  78. namely name, aliases, addrtype, length, and addr_list.  The aliases and
  79. addr_list methods return array reference, the rest scalars.  The addr
  80. method is equivalent to the zeroth element in the addr_list array
  81. reference.
  82.  
  83. You may also import all the structure fields directly into your namespace
  84. as regular variables using the :FIELDS import tag.  (Note that this still
  85. overrides your core functions.)  Access these fields as variables named
  86. with a preceding C<h_>.  Thus, C<$host_obj-E<gt>name()> corresponds to
  87. $h_name if you import the fields.  Array references are available as
  88. regular array variables, so for example C<@{ $host_obj-E<gt>aliases()
  89. }> would be simply @h_aliases.
  90.  
  91. The gethost() funtion is a simple front-end that forwards a numeric
  92. argument to gethostbyaddr() by way of Socket::inet_aton, and the rest
  93. to gethostbyname().
  94.  
  95. To access this functionality without the core overrides,
  96. pass the C<use> an empty import list, and then access
  97. function functions with their full qualified names.
  98. On the other hand, the built-ins are still available
  99. via the C<CORE::> pseudo-package.
  100.  
  101. =head1 EXAMPLES
  102.  
  103.  use Net::hostent;
  104.  use Socket;
  105.  
  106.  @ARGV = ('netscape.com') unless @ARGV;
  107.  
  108.  for $host ( @ARGV ) {
  109.  
  110.     unless ($h = gethost($host)) {
  111.     warn "$0: no such host: $host\n";
  112.     next;
  113.     }
  114.  
  115.     printf "\n%s is %s%s\n", 
  116.         $host, 
  117.         lc($h->name) eq lc($host) ? "" : "*really* ",
  118.         $h->name;
  119.  
  120.     print "\taliases are ", join(", ", @{$h->aliases}), "\n"
  121.         if @{$h->aliases};     
  122.  
  123.     if ( @{$h->addr_list} > 1 ) { 
  124.     my $i;
  125.     for $addr ( @{$h->addr_list} ) {
  126.         printf "\taddr #%d is [%s]\n", $i++, inet_ntoa($addr);
  127.     } 
  128.     } else {
  129.     printf "\taddress is [%s]\n", inet_ntoa($h->addr);
  130.     } 
  131.  
  132.     if ($h = gethostbyaddr($h->addr)) {
  133.     if (lc($h->name) ne lc($host)) {
  134.         printf "\tThat addr reverses to host %s!\n", $h->name;
  135.         $host = $h->name;
  136.         redo;
  137.     } 
  138.     }
  139.  }
  140.  
  141. =head1 NOTE
  142.  
  143. While this class is currently implemented using the Class::Struct
  144. module to build a struct-like class, you shouldn't rely upon this.
  145.  
  146. =head1 AUTHOR
  147.  
  148. Tom Christiansen
  149.